home *** CD-ROM | disk | FTP | other *** search
/ WINMX Assorted Textfiles / Ebooks.tar / Text - Mathematics - Numerical Mathematics and Computing (F).zip / seidel.f < prev    next >
Text File  |  2002-06-11  |  2KB  |  86 lines
  1. C
  2. C PAGE 449-451: NUMERICAL MATHEMATICS AND COMPUTING, CHENEY/KINCAID, 1985
  3. C
  4. C FILE: SEIDEL.FOR
  5. C
  6. C ELLIPTIC PDE SOLVED BY DISCRETIZATION AND GAUSS-SEIDEL METHOD
  7. C  (SEIDEL,F,G,BNDY,USTART,TRUE)
  8. C
  9.       PARAMETER  (IU = 9)   
  10.       DIMENSION  U(IU,IU)   
  11.       DATA  AX,BX/0.0,1.0/, AY,BY/0.0,1.0/  
  12.       DATA  NX,NY/2*9/, ITMAX/20/     
  13.       H = (BX - AX)/REAL(NX - 1)      
  14.       DO 2 J = 1,NY 
  15.         Y = AY + REAL(J-1)*H
  16.         U(1,J)  = BNDY(AX,Y)
  17.         U(NX,J) = BNDY(BX,Y)
  18.    2  CONTINUE
  19.       DO 3 I = 1,NX 
  20.         X = AX + REAL(I-1)*H
  21.         U(I,1)  = BNDY(X,AY)
  22.         U(I,NY) = BNDY(X,BY)
  23.    3  CONTINUE
  24.       DO 5 J = 2,NY-1       
  25.         Y = AY + REAL(J-1)*H
  26.         DO 4 I = 2,NX-1     
  27.           X = AX + REAL(I-1)*H
  28.           U(I,J) = USTART(X,Y)
  29.    4    CONTINUE
  30.    5  CONTINUE    
  31.       PRINT 8,0,((U(I,J),I = 1,NX),J = 1,NY)    
  32.       CALL SEIDEL(AX,AY,NX,NY,H,ITMAX,U,IU)     
  33.       PRINT 8,ITMAX,((U(I,J),I = 1,NX),J = 1,NY)
  34.       DO 7 J = 1,NY 
  35.         Y = AY + REAL(J-1)*H
  36.         DO 6 I = 1,NX       
  37.           X = AX + REAL(I-1)*H
  38.           U(I,J) = ABS( TRUE(X,Y) - U(I,J) )  
  39.    6    CONTINUE
  40.    7  CONTINUE    
  41.       PRINT 8,ITMAX,((U(I,J),I = 1,NX),J = 1,NY)
  42.    8  FORMAT(//4X,I5,//(9(2X,E12.5))) 
  43.       STOP
  44.       END 
  45.         
  46.       FUNCTION F(X,Y)       
  47.       F = -25.0 
  48.       RETURN      
  49.       END 
  50.         
  51.       FUNCTION G(X,Y)       
  52.       G = 0.0 
  53.       RETURN      
  54.       END 
  55.         
  56.       FUNCTION BNDY(X,Y)    
  57.       BNDY = TRUE(X,Y)    
  58.       RETURN      
  59.       END 
  60.         
  61.       FUNCTION USTART(X,Y)  
  62.       USTART = 1.0
  63.       RETURN      
  64.       END 
  65.         
  66.       FUNCTION TRUE(X,Y)    
  67.       TRUE = 0.5*(COSH(5.0*X) + COSH(5.0*Y))/COSH(5.0)
  68.       RETURN      
  69.       END 
  70.   
  71.       SUBROUTINE SEIDEL(AX,AY,NX,NY,H,ITMAX,U,IU) 
  72.       DIMENSION  U(IU,NY)   
  73.       HSQ = H*H   
  74.       DO 4 K = 1,ITMAX      
  75.         DO 3 J = 2,NY-1     
  76.           Y = AY + REAL(J-1)*H
  77.           DO 2 I = 2,NX-1   
  78.             X = AX + REAL(I-1)*H      
  79.             V = U(I+1,J) + U(I-1,J) + U(I,J+1) + U(I,J-1) 
  80.             U(I,J) = (V - HSQ*G(X,Y))/(4.0 - HSQ*F(X,Y))  
  81.    2      CONTINUE
  82.    3    CONTINUE  
  83.    4  CONTINUE    
  84.       RETURN      
  85.       END 
  86.